home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / FROMUTS / XLISP1 / !XLisp / c / XLISP < prev    next >
Text File  |  1990-02-24  |  2KB  |  101 lines
  1. /* xlisp - a small implementation of lisp with object-oriented programming */
  2. /*    Copyright (c) 1985, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xlisp.h"
  7.  
  8. /* define the banner line string */
  9. #define BANNER    "XLISP version 1.6, Copyright (c) 1985, by David Betz\nArchimedes Version by Geoff. Lane."
  10.  
  11. /* external variables */
  12. extern NODE *s_stdin,*s_stdout;
  13. extern NODE *s_evalhook,*s_applyhook;
  14. extern int xldebug;
  15. extern NODE *true;
  16.  
  17. /* main - the main routine */
  18. main(argc,argv)
  19.   int argc; char *argv[];
  20. {
  21.     CONTEXT cntxt;
  22.     NODE *expr;
  23.     int i;
  24.  
  25.     /* initialize and print the banner line */
  26.     osinit(BANNER);
  27.  
  28.     /* setup initialization error handler */
  29.     xlbegin(&cntxt,CF_TOPLEVEL|CF_ERROR,(NODE *) 1);
  30.     if (setjmp(cntxt.c_jmpbuf)) {
  31.     printf("fatal initialization error\n");
  32.     osfinish();
  33.     exit(1);
  34.     }
  35.  
  36.     /* initialize xlisp */
  37.     xlinit();
  38.     xlend(&cntxt);
  39.  
  40.     /* reset the error handler */
  41.     xlbegin(&cntxt,CF_TOPLEVEL|CF_ERROR,true);
  42.  
  43.     /* load "init.lsp" */
  44.     if (setjmp(cntxt.c_jmpbuf) == 0)
  45.     xlload("<XLisp$Init>",FALSE,FALSE);
  46.  
  47.     /* load any files mentioned on the command line */
  48. #ifndef MEGAMAX
  49.     if (setjmp(cntxt.c_jmpbuf) == 0)
  50.     for (i = 1; i < argc; i++)
  51.         if (!xlload(argv[i],TRUE,FALSE))
  52.         xlfail("can't load file");
  53. #endif
  54.  
  55.     /* create a new stack frame */
  56.     xlsave(&expr,(NODE **)NULL);
  57.  
  58.     /* main command processing loop */
  59.     while (TRUE) {
  60.  
  61.     /* setup the error return */
  62.     if (i = setjmp(cntxt.c_jmpbuf)) {
  63.         if (i == CF_TOPLEVEL)
  64.         stdputstr("[ back to the top level ]\n");
  65.         setvalue(s_evalhook,NIL);
  66.         setvalue(s_applyhook,NIL);
  67.         xldebug = 0;
  68.         xlflush();
  69.     }
  70.  
  71.     /* read an expression */
  72.     if (!xlread(getvalue(s_stdin),&expr,FALSE))
  73.         break;
  74.  
  75.     /* evaluate the expression */
  76.     expr = xleval(expr);
  77.  
  78.     /* print it */
  79.     stdprint(expr);
  80.     }
  81.     xlend(&cntxt);
  82.     osfinish ();
  83.     exit (0);
  84. }
  85.  
  86. /* stdprint - print to standard output */
  87. stdprint(expr)
  88.   NODE *expr;
  89. {
  90.     xlprint(getvalue(s_stdout),expr,TRUE);
  91.     xlterpri(getvalue(s_stdout));
  92. }
  93.  
  94. /* stdputstr - print a string to standard output */
  95. stdputstr(str)
  96.   char *str;
  97. {
  98.     xlputstr(getvalue(s_stdout),str);
  99. }
  100.  
  101.